home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Aminet 1 (Walnut Creek)
/
Aminet - June 1993 [Walnut Creek].iso
/
aminet
/
util
/
gnu
/
gnu_tile_forth.lha
/
lib
/
double.f83
< prev
next >
Wrap
Text File
|
1992-05-19
|
2KB
|
88 lines
\
\ DOUBLE PARAMETER STACK WORD DEFINITIONS
\
\ Copyright (C) 1990 by Mikael R.K. Patel
\
\ Computer Aided Design Laboratory (CADLAB)
\ Department of Computer and Information Science
\ Linkoping University
\ S-581 83 LINKOPING
\ SWEDEN
\
\ Email: mip@ida.liu.se
\
\ Started on: 26 February 1990
\
\ Last updated on: 26 February 1990
\
\ Dependencies:
\ (forth) forth, structures, macros
\
\ Description:
\ Stack manipulation definitions for pairs of parameters.
\
\ Copying:
\ This program is free software; you can redistribute it and\or modify
\ it under the terms of the GNU General Public License as published by
\ the Free Software Foundation; either version 1, or (at your option)
\ any later version.
\
\ This program is distributed in the hope that it will be useful,
\ but WITHOUT ANY WARRANTY; without even the implied warranty of
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
\ GNU General Public License for more details.
\
\ You should have received a copy of the GNU General Public License
\ along with this program; see the file COPYING. If not, write to
\ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
.( Loading Double Parameter definitions...) cr
#include structures.f83
#include macros.f83
structures macros forth definitions
struct.type DOUBLE ( low high -- )
long +high ( double -- addr)
long +low ( double -- addr)
struct.init ( low high double -- )
#ifundef 2!
tuck +high ! +low !
#else
2!
#then
struct.end
: double ( low high -- )
create , ,
does> ( double -- low high)
#ifundef 2@
dup +low @ swap +high @
#else
2@
#then
;
: .double ( addr -- )
." double#" dup . ." high: " dup +high @ . ." low: " +low @ .
;
#ifundef 2swap \ Check if the kernel supports double parameters
: 2>r ( a b -- ) >r >r ; macro compilation
: 2r> ( -- a b) r> r> swap ; macro compilation
: 2drop ( a b - ) drop drop ; macro
: 2swap ( a b c d -- c d a b) rot >r rot r> ; macro
: 2rot ( a b c d e f -- c d e f a b) 2>r 2swap 2r> 2swap ;
: 2dup ( a b -- a b a b) over over ; macro
: 2over ( a b c d -- a b c d a b) 3 pick 3 pick ; macro
: 2@f ( addr -- a b) dup +low @ swap +high @ ; macro
: 2! ( a b addr -- ) tuck +high ! +low ! ; macro
#then
forth only